Shareware Grab Bag/Shareware Grab Bag.iso/003/pssst.arc/PSSEARCH.PRG

Text File | 1986-08-15 | 10.5 KB | 347 lines

* PSTSRCHP.PRG
*
* A DBASE II 16BIT COMMAND FILE to allow finding a phone number
* in PHONE.DBF by matching any of nine variables input by user.
*
* Version 1
* By LTC Denny Hugg
* ANGSC/DOS Andrews AFB MD 16 Jul 1985
*
* Version 2
* modified by Maj Jim McMurry
* ANGSC/DOSC Truax Field, WI 15 Jun 1986
*
*
DO WHILE T
   ERASE
   STORE 'TELEPHONE SEARCH / PRINT' TO heading
   DO PSHEADING
   STORE 'LN' TO p1
   STORE 'FN' TO p2
   STORE 'RK' TO p3
   STORE 'U#' TO p4
   STORE 'UT' TO p5
   STORE 'IC' TO p6
   STORE 'OS' TO p7
   STORE 'SB' TO p8
   STORE 'AV' TO p9
   STORE 'ST' TO p10
   STORE 'RET' TO p11
   STORE ' '+p1+'  '+p2+'  '+p3+'  '+p4+'  '+p5+'  '+p6+;
         '  '+p7+'  '+p8+'  '+p9+'  '+p10+'  '+p11+'  ' TO lin
   STORE '               (Find By Last Name)' TO y1
   STORE '              (Find By First Name)' TO y2
   STORE '                    (Find By Rank)' TO y3
   STORE '             (Find By Unit Number)' TO y4
   STORE '               (Find By Unit Type)' TO y5
   STORE '                    (Find By ICAO)' TO y6
   STORE '           (Find By Office Symbol)' TO y7
   STORE '                 (Find By Subject)' TO y8
   STORE '          (Find By Autovon Prefix)' TO y9
   STORE '                   (Find by State)' TO y10
   STORE '       (Return To Main Phone Menu)' TO y11
   STORE '0004081216202428323640' TO col
   STORE 1 TO c
   STORE '1' TO z
   STORE '0' TO mcho
   STORE t TO screen
   @ 22,0 SAY gline
   DO WHILE screen
      @ 22,79 SAY lin + y&z
      @ 23,VAL($(col,c,2)) GET p&z
      CLEAR GETS
      SET CONSOLE OFF
      STORE '0' TO mcho
      DO WHILE ' '<>mcho .AND. .NOT. mcho$'DCKM46'
         WAIT TO mcho
      ENDDO
      SET CONSOLE ON
      DO CASE
         CASE mcho$('CM6')
            IF c#21
               STORE c+2 TO c
               IF c<19
                  STORE str(val(z)+1,1) TO z
               ELSE
                  STORE str(val(z)+1,2) TO z
               ENDIF
            ELSE
               STORE 1 TO c
               STORE '1' TO z
            ENDIF
         CASE mcho$('KD4')
            IF c>1
               STORE c-2 TO c
               IF c<19
                  STORE str(val(z)-1,1) TO z
               ELSE
                  STORE str(val(z)-1,2) TO z
               ENDIF
            ELSE
               STORE 21 TO c
               STORE '11' TO z
            ENDIF
         CASE mcho = ' '
            STORE f TO screen
            LOOP
      ENDCASE
   ENDDO
   @ 22, 0 SAY gclearline
   @ 22,79 SAY gclearline
   DO CASE
      CASE c=1
         @  0, 0 SAY gcuron
         STORE '           ' TO requested
         @ 22,25 SAY 'Last Name Desired ' GET requested PICTURE '!!!!!!!!!!!'
         READ
         STORE "lname = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '           '
            LOOP
         ENDIF
      CASE c=3
         @  0, 0 SAY gcuron
         STORE '       ' TO requested
         @ 22,27 SAY 'First Name Desired ' GET requested PICTURE '!!!!!!!'
         READ
         STORE "fname = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '       '
            LOOP
         ENDIF
      CASE c=5
         @  0, 0 SAY gcuron
         STORE '     ' TO requested
         @ 22,31 SAY 'Rank Desired ' GET requested PICTURE '!!!!!'
         READ
         STORE "rank = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '     '
            LOOP
         ENDIF
      CASE c=7
         @  0, 0 SAY gcuron
         STORE '   ' TO requested
         @ 22,28 SAY 'Unit Number Desired ' GET requested PICTURE '999'
         READ
         STORE "unitno = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '   '
            LOOP
         ENDIF
      CASE c=9
         @  0, 0 SAY gcuron
         STORE '      ' TO requested
         @ 22,28 SAY 'Unit Type Desired ' GET requested PICTURE '!!!!!!'
         READ
         STORE "unitype = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '      '
            LOOP
         ENDIF
      CASE c=11
         @  0, 0 SAY gcuron
         STORE '   ' TO requested
         @ 22,26 SAY 'Location (ICAO) Desired ' GET requested PICTURE '!!!'
         READ
         STORE "icao = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '   '
            LOOP
         ENDIF
      CASE c=13
         @  0, 0 SAY gcuron
         STORE '    ' TO requested
         @ 22,27 SAY 'Office Symbol Desired ' GET requested PICTURE '!!!!'
         READ
         STORE "offsym = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '    '
            LOOP
         ENDIF
      CASE c=15
         @  0, 0 SAY gcuron
         STORE '                ' TO requested
         @ 22,26 SAY 'Subject Desired ';
                 GET requested PICTURE '!!!!!!!!!!!!!!!!'
         READ
         STORE "subject = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '                '
            LOOP
         ENDIF
      CASE c=17
         @  0, 0 SAY gcuron
         STORE '   ' TO requested
         @ 22,27 SAY 'Autovon Prefix Desired ' GET requested PICTURE '999'
         READ
         STORE "avnop = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '    '
            LOOP
         ENDIF
      CASE c=19
         @  0, 0 SAY gcuron
         STORE '  ' TO requested
         @ 22,32 SAY 'State Desired ' GET requested PICTURE '!!'
         READ
         STORE "state = '" + TRIM(requested) + "'" TO condition
         @  0, 0 SAY gcuroff
         IF requested = '  '
            LOOP
         ENDIF
      CASE c=21
         RELEASE ALL EXCEPT g*
         RETURN
   ENDCASE
   IF $(requested,1,1) = ' '
      * --- he added some leading space(s)
      STORE 1 TO pointer
      * --- locate the first non-empty character
      DO WHILE $(requested,pointer,1) = ' '
         STORE pointer + 1 TO pointer
      ENDDO
      * --- get the non-empty characters
      STORE $(requested,pointer,LEN(requested)-pointer + 1) TO requested
   ENDIF
   RELEASE pointer
   STORE TRIM(requested) TO requested
   @  0, 0 SAY gcuroff
   STORE ' ' TO moutput
   USE PSPHONE INDEX PSPHONEI
   IF c=1
      FIND &requested
   ENDIF
   @ 22, 0 SAY gclearline
   @ 22,16 SAY 'Do You Want Output On Screen Or Printer? (S/P):'
   DO WHILE moutput <> 'S' .AND. moutput <> 'P'
      STORE ' ' TO moutput
      @ 22,63 GET moutput PICTURE '!'
      READ
   ENDDO
   @ 22, 0 SAY gclearline
* --- considered indexing and using FIND.  A test on a 140 record database
* --- (on a floppy drive) yielded 51 seconds this way, and 58 seconds  to
* --- create an index then use the FIND followed by DO WHILE loop.  Since
* --- I'm not going to carry 10 indexes on this database, this is the best way.
   IF moutput = 'P'
      STORE 56 TO mpagelen
      STORE 1 TO pageno
      @ 10,32 SAY 'Printing Now ...'
      SET FORMAT TO PRINT
      STORE 2 TO mline
      STORE '----------------------------------------';
           +'----------------------------------------' TO gline
   ELSE
      ERASE
      STORE 20 TO mpagelen
      STORE 0 TO mline
   ENDIF
   IF moutput = 'P'
      @ mline, 1 SAY 'Page no. ' + STR(pageno,1)
      @ mline, 31 - INT((LEN(requested)+.5)/2) SAY 'LISTING OF ALL ';
                                   + requested + "S"
      @ mline,71 SAY gdate
      STORE mline + 1 TO mline
   ELSE
      STORE 1 TO line
      STORE 'LISTING ' + requested + "'S" TO prompt
      DO PSPROMPT
   ENDIF
   STORE mline + 3 TO mline
   * --- print the info
   STORE 0 TO mpasses
   @ mline, 0 SAY 'LAST NAME'
   @ mline,12 SAY 'FIRST'
   @ mline,20 SAY 'RANK'
   @ mline,27 SAY 'O/S'
   @ mline,33 SAY 'U/#'
   @ mline,38 SAY 'TYPE'
   @ mline,46 SAY 'LOC'
   @ mline,51 SAY 'ST'
   @ mline,55 SAY 'SUBJECT'
   @ mline,72 SAY 'PHONE'
   STORE mline + 1 TO mline
   @ mline, 0 SAY gline
   STORE mline + 1 TO mline
   DO WHILE .NOT. EOF
      IF mline > mpagelen
         STORE 2 TO mline
         IF moutput = "S"
            @ 22,23 SAY "- Please Hit Any Key To Continue -"
            SET CONSOLE OFF
            WAIT
            SET CONSOLE ON
            ERASE
         ELSE
            EJECT
            STORE pageno + 1 TO pageno
            @ mline, 0 SAY 'Page no. ' + STR(pageno,1)
            @ mline,72 SAY gdate
            STORE mline + 3 To mline
         ENDIF
         @ mline, 0 SAY 'LAST NAME'
         @ mline,12 SAY 'FIRST'
         @ mline,20 SAY 'RANK'
         @ mline,27 SAY 'O/S'
         @ mline,33 SAY 'U/#'
         @ mline,38 SAY 'TYPE'
         @ mline,46 SAY 'LOC'
         @ mline,51 SAY 'ST'
         @ mline,55 SAY 'SUBJECT'
         @ mline,72 SAY 'PHONE'
         STORE mline + 1 TO mline
         @ mline, 0 SAY gline
         STORE mline + 1 TO mline
      ENDIF
      IF .NOT. &condition
         SKIP
         LOOP
      ENDIF
      @ mline, 0 SAY lname
      @ mline,12 SAY fname
      @ mline,20 SAY rank
      @ mline,27 SAY offsym
      @ mline,33 SAY unitno
      @ mline,38 SAY unitype
      @ mline,46 SAY icao
      @ mline,51 SAY state
      @ mline,55 SAY subject
      @ mline,72 SAY avnop + '-' + avnos
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
      SKIP
   ENDDO
   IF mpasses = 0
      @ 10,26 - INT((LEN(requested)+.5)/2) SAY 'There Is No ';
                                   + requested + ' In The Database'
      STORE 0 TO timer
      DO WHILE timer <= gdelay
         STORE timer + 1 TO timer
      ENDDO
   ENDIF
   IF moutput = "S" .AND. mpasses <> 0
      @ 22,22 SAY "- Please Strike Any Key To Continue -"
      SET CONSOLE OFF
      WAIT
      SET CONSOLE ON
      @ 22, 0 SAY gclearline
   ELSE
      * --- dumps last line out of printer buffer
      @ 0, 0 SAY CHR(13)
      SET FORMAT TO SCREEN
      @ 10, 0 SAY gclearline
   ENDIF
ENDDO T
* --- EOF PSTSRCHP.PRG
RCHP.PRG
utput = "S"
            @ 22,23 SAY "- Please Hit Any Key To Continue -"
            SET CONSOLE OFF
            WAIT
            SET CONSOLE ON
            ERASE
         ELSE
            EJECT
            STORE pageno + 1 TO pageno
            @